VERSION 5.00
Begin VB.UserControl ucVList 
   BackColor       =   &H00FFFFFF&
   ClientHeight    =   3915
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4155
   DrawStyle       =   5  'Transparent
   BeginProperty Font 
      Name            =   "Arial"
      Size            =   9
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   HasDC           =   0   'False
   KeyPreview      =   -1  'True
   ScaleHeight     =   261
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   277
   Begin VB.PictureBox picDraw 
      Appearance      =   0  '2D
      AutoRedraw      =   -1  'True
      BackColor       =   &H00FFFFFF&
      BorderStyle     =   0  'Kein
      Enabled         =   0   'False
      ForeColor       =   &H80000008&
      Height          =   2175
      Left            =   300
      ScaleHeight     =   145
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   157
      TabIndex        =   2
      Top             =   1500
      Width           =   2355
   End
   Begin VB.PictureBox picHeader 
      AutoRedraw      =   -1  'True
      BackColor       =   &H00F6F6F6&
      BorderStyle     =   0  'Kein
      BeginProperty Font 
         Name            =   "Arial"
         Size            =   9.75
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   255
      Left            =   -30
      ScaleHeight     =   17
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   763
      TabIndex        =   1
      TabStop         =   0   'False
      Top             =   0
      Width           =   11445
   End
   Begin VB.TextBox mEditBox 
      BackColor       =   &H00D0FFFF&
      BorderStyle     =   0  'Kein
      Height          =   285
      Left            =   210
      TabIndex        =   0
      Top             =   510
      Visible         =   0   'False
      Width           =   1515
   End
End
Attribute VB_Name = "ucVList"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'A relatively simple and straightforward VirtualList-Control (Olaf Schmidt 2012)
'It is based on the OwnerDraw-Mode of a normal VB-Listbox, using the subclassed
'Message (WM_DRAWITEM) on the ListBox's HostWnd (this UserControl.hWnd here)
'Code-Dependencies: modIDESafeSubClassing, cSubClass (here used with the RC5, which already comes with cSubClass)
'the rendering on it should behave flickerfree, in conjunction with a (CoomonControl-)manifested App
Option Explicit

Private Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type
 
Private Type DRAWTEXTPARAMS
  cbSize As Long
  iTabLength As Long
  iLeftMargin As Long
  iRightMargin As Long
  uiLengthDrawn As Long
End Type

Private Declare Function CreateWindowEx Lib "user32" Alias "CreateWindowExA" (ByVal dwExStyle As Long, ByVal lpClassName As String, ByVal lpWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal hMenu As Long, ByVal hInstance As Long, lpParam As Any) As Long
Private Declare Function DestroyWindow Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function MoveWindow Lib "user32" (ByVal hWnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Private Declare Function RedrawWindow Lib "user32" (ByVal hWnd As Long, ByVal lprcUpdate As Long, ByVal hrgnUpdate As Long, ByVal fuRedraw As Long) As Long
Private Declare Function SetFocusAPI Lib "user32" Alias "SetFocus" (ByVal hWnd As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As Any) As Long
Private Declare Function ScreenToClient Lib "user32" (ByVal hWnd As Long, lpPoint As Any) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function GetScrollPos Lib "user32" (ByVal hWnd As Long, ByVal nBar As Long) As Long
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer

Private Declare Sub RtlMoveMemory Lib "kernel32" (Dst As Any, Src As Any, ByVal Bytes&)
 
Private Declare Function DrawTextEx Lib "user32" Alias "DrawTextExW" (ByVal hDC As Long, ByVal lpsz As Long, ByVal n As Long, lpRect As RECT, ByVal un As Long, lpDrawTextParams As Any) As Long
Private Declare Function CreateSolidBrush Lib "gdi32" (ByVal crColor As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function SetTextColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
Private Declare Function FillRect Lib "user32" (ByVal hDC As Long, lpRect As RECT, ByVal hBrush As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hDC As Long, ByVal nBkMode As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, Optional ByVal POld As Long) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long) As Long

Private Const WS_CHILD& = &H40000000, WS_VISIBLE& = &H10000000, WS_VSCROLL& = &H200000, WS_HSCROLL& = &H100000, WS_TABSTOP& = &H10000
Private Const LBS_OWNERDRAWFIXED = &H10&, LBS_NODATA& = &H2000&, LBS_NOINTEGRALHEIGHT& = &H100&, LBS_NOTIFY& = 1
Private Const LB_SETCOUNT& = &H1A7&, LB_SETITEMHEIGHT& = &H1A0&, LB_SETHORIZONTALEXTENT = &H194&, LB_GETITEMRECT& = &H198
Private Const LB_SETCURSEL& = &H186, LB_GETCURSEL& = &H188, LB_GETTOPINDEX& = &H18E, LB_SETTOPINDEX& = &H197, WM_SETREDRAW = 11
'---------------------------- end of the API-Declare-Section -----------------------------

Public Enum DTAlignment
  DT_LEFT
  DT_CENTER
  DT_RIGHT
End Enum

Public Enum ColSortMode
  CS_NONE
  CS_ASCENDING
  CS_DESCENDING
End Enum

Event EditBoxProvideContent(ByVal Index As Long, ByVal ColIndex As Long, EditContent As String)
Event EditBoxChange(ByVal Index As Long, ByVal ColIndex As Long, EditContent As String, ByVal CurrentSortColumn As Long, ByVal CurrentSortMode As ColSortMode)
Event HeaderClick(ByVal Index As Long, ByVal ColIndex As Long, ByVal CurrentSortMode As ColSortMode)
Event DblClick(ByVal Index As Long, ByVal ColIndex As Long)
Event Click(ByVal Index As Long, ByVal ColIndex As Long)
Event OwnerDrawHeader(ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal dx As Long, ByVal dy As Long)
Event OwnerDrawItem(ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal dx As Long, ByVal dy As Long, ByVal Index As Long, ByVal IsSelected As Boolean)

Public ColWidths As New Collection

Private lbHwnd As Long, WithEvents ucSC As cSubClass, WithEvents Ext As VBControlExtender
Attribute lbHwnd.VB_VarHelpID = -1
Attribute ucSC.VB_VarHelpID = -1
Attribute Ext.VB_VarHelpID = -1
Private mListCount As Long, mHeaderHeight As Long, mRowHeight As Long, ListCountChanged As Boolean
Private mColScan As Boolean, mColWidthTotal As Long, mBlockClickEvents As Boolean
Private mLastLBX As Long, mLastHDX As Long, mHScrollX As Long, mFocused As Boolean
Private mSortColumn As Long, mSortMode As ColSortMode, mSortColor As Long
Private mAllowEdit As Boolean, mEditBlockChangeEvent As Boolean, mEditColumn As Long
 
Private Sub UserControl_Resize()
  If Ambient.UserMode Then Set Ext = Extender Else Exit Sub
  SendMessage lbHwnd, WM_SETREDRAW, 0, ByVal 0&
    ScaleMode = vbPixels
    Init
    picDraw.Move 0, mHeaderHeight
    MoveWindow lbHwnd, 0, mHeaderHeight, ScaleWidth, ScaleHeight - mHeaderHeight, 1
    UpdateHeader
    EditMove
  SendMessage lbHwnd, WM_SETREDRAW, 1, ByVal 0&
  Refresh
End Sub
 
Private Sub UpdateHeader()
  picHeader.Move 0, 0, ScaleWidth, mHeaderHeight
  Set ColWidths = New Collection
  mColScan = True: mColWidthTotal = 0
    RefreshHeader
  mColScan = False
  If mColWidthTotal > ScaleWidth Or ColWidths.Count > 1 Then SendMessage lbHwnd, LB_SETHORIZONTALEXTENT, mColWidthTotal - 1, ByVal 0&
End Sub

Private Sub Init()
Static Done As Boolean: If Not Done Then Done = True Else Exit Sub
Const Style As Long = WS_CHILD Or WS_VISIBLE Or WS_VSCROLL Or WS_HSCROLL Or WS_TABSTOP Or _
                      LBS_OWNERDRAWFIXED Or LBS_NODATA Or LBS_NOINTEGRALHEIGHT Or LBS_NOTIFY
  lbHwnd = CreateWindowEx(0, "listbox", "", Style, 0, 0, 150, 50, hWnd, 0, App.hInstance, ByVal 0&)
  Set ucSC = New_c.SubClass
      ucSC.Hook hWnd
  RowHeight = IIf(mRowHeight < 2, 17, mRowHeight)
End Sub

Public Property Get ScrollerSize() As Long
Dim Rct As RECT
    SendMessage lbHwnd, LB_GETITEMRECT, 0, Rct
    ScrollerSize = ScaleWidth - (Rct.Right - mHScrollX)
End Property

Public Property Get ListCount() As Long
  ListCount = mListCount
End Property
Public Property Let ListCount(ByVal RHS As Long)
  If RHS < 0 Then RHS = 0
  If RHS = ListCount Then Exit Property
  mBlockClickEvents = True
  SendMessage lbHwnd, WM_SETREDRAW, 0, ByVal 0&
    mListCount = RHS
    mSortMode = CS_NONE
    mEditBox.Visible = False
    
    Dim LI As Long: LI = ListIndex
    Dim TI As Long: TI = TopIndex
      SendMessage lbHwnd, LB_SETCOUNT, mListCount, ByVal 0&
    ListIndex = LI
    TopIndex = TI
    UpdateHeader
  SendMessage lbHwnd, WM_SETREDRAW, 1, ByVal 0&
  ListCountChanged = True
  mBlockClickEvents = False
  Refresh
End Property

Public Property Get Focused() As Boolean
  Focused = mFocused
End Property

Public Property Get VisibleRows() As Long
Dim VRows As Long
  VRows = ((ScaleHeight - mHeaderHeight + 2) - IIf(mColWidthTotal > ScaleWidth, 19, 2)) \ mRowHeight
  VisibleRows = IIf(VRows > mListCount, mListCount, VRows)
End Property

Public Property Get TopIndex() As Long
  TopIndex = SendMessage(lbHwnd, LB_GETTOPINDEX, 0, ByVal 0&)
End Property
Public Property Let TopIndex(ByVal RHS As Long)
  SendMessage lbHwnd, LB_SETTOPINDEX, RHS, ByVal 0&
End Property
Public Property Get ListIndex() As Long
  ListIndex = SendMessage(lbHwnd, LB_GETCURSEL, 0, ByVal 0&)
End Property
Public Property Let ListIndex(ByVal RHS As Long)
  If RHS = ListIndex Then Exit Property
  SendMessage lbHwnd, LB_SETCURSEL, RHS, ByVal 0&
  If Not mBlockClickEvents Then RaiseEvent Click(ListIndex, GetColumnIndex(mLastLBX))
End Property

Public Property Get RowHeight() As Long
  RowHeight = mRowHeight
End Property
Public Property Let RowHeight(ByVal RHS As Long)
  mRowHeight = IIf(RHS < 4, 4, RHS)
  SendMessage lbHwnd, LB_SETITEMHEIGHT, 0, ByVal mRowHeight
End Property
Public Property Get HeaderHeight() As Long
  HeaderHeight = mHeaderHeight
End Property
Public Property Let HeaderHeight(ByVal RHS As Long)
  mHeaderHeight = IIf(RHS < 0, 0, IIf(RHS > 40, 40, RHS))
  UserControl_Resize
End Property

Public Property Get BackColor() As Long
  BackColor = UserControl.BackColor
End Property
Public Property Let BackColor(ByVal RHS As Long)
  UserControl.BackColor = RHS
  Refresh
End Property

Public Property Get AllowEdit() As Boolean
  AllowEdit = mAllowEdit
End Property
Public Property Let AllowEdit(ByVal RHS As Boolean)
  mAllowEdit = RHS
  Set mEditBox.Font = Font
  UserControl_Resize
End Property
Public Property Get EditBox() As Object
  Set EditBox = mEditBox
End Property

Public Property Get SortMode() As ColSortMode
  SortMode = mSortMode
End Property
Public Property Get SortColumn() As Long
  SortColumn = mSortColumn
End Property

Public Sub Refresh()
  RedrawWindow lbHwnd, 0, 0, &H101&
End Sub
Private Sub RefreshHeader()
Dim Rct As RECT
  If lbHwnd Then SendMessage lbHwnd, LB_GETITEMRECT, 0, Rct
  picHeader.Cls
  RaiseEvent OwnerDrawHeader(picHeader.hDC, -mHScrollX, 0, ScaleWidth + mHScrollX, mHeaderHeight)
  If mSortMode Then DrawSortIndicator
  picHeader.Refresh
End Sub
 
Public Property Get Font() As StdFont
  Set Font = UserControl.Font
End Property
 
Private Sub EditMove(Optional ByVal MakeVisible As Boolean)
Dim x As Long, y As Long, dx As Long, dy As Long, EditContent As String
  If Not mAllowEdit Then mEditBox.Visible = False: Exit Sub
  If ColWidths.Count = 0 Then Exit Sub
  
  mEditColumn = GetColumnIndex(mLastLBX, x)
  dx = ColWidths(mEditColumn + 1) - 4
  If x + dx > ScaleWidth - IIf(mListCount > VisibleRows, 19, 2) Then dx = (ScaleWidth - IIf(mListCount > VisibleRows, 19, 2)) - x
  If dx < 1 Then dx = 1
  y = (ListIndex - TopIndex) * mRowHeight + mHeaderHeight + 1
  dy = mRowHeight - 3
  If y < mHeaderHeight Or x + 2 > ScaleWidth - IIf(mListCount > VisibleRows, 18, 2) Then y = -100: dx = 1
  If y + dy > ScaleHeight - IIf(mColWidthTotal > ScaleWidth, 19, 2) Then y = -100: dx = 1

  mEditBox.Move x + 2, y, dx, dy + 1

  If MakeVisible Then mEditBlockChangeEvent = True Else mEditBox.Refresh: Exit Sub
    RaiseEvent EditBoxProvideContent(ListIndex, mEditColumn, EditContent)
    mEditBox.Text = EditContent
    mEditBox.SelStart = 0: mEditBox.SelLength = 10000
    If Not mEditBox.Visible Then mEditBox.Visible = True
    mEditBox.SetFocus: DoEvents: mEditBox.Refresh
  mEditBlockChangeEvent = False
End Sub
Private Sub mEditBox_Change()
  If mEditBlockChangeEvent Then Exit Sub
  RaiseEvent EditBoxChange(ListIndex, mEditColumn, mEditBox.Text, mSortColumn, mSortMode)
  EditMove
End Sub
 
Private Sub Ext_Validate(Cancel As Boolean)
  If GetAsyncKeyState(vbKeyUp) Then
    Cancel = True: If ListIndex > 0 Then ListIndex = ListIndex - 1
  ElseIf GetAsyncKeyState(vbKeyLeft) Then
    Cancel = True: If ListIndex > 0 Then ListIndex = ListIndex - 1
  ElseIf GetAsyncKeyState(vbKeyDown) Then
    Cancel = True: If ListIndex < mListCount - 1 Then ListIndex = ListIndex + 1
  ElseIf GetAsyncKeyState(vbKeyRight) Then
    Cancel = True: If ListIndex < mListCount - 1 Then ListIndex = ListIndex + 1
  End If
  mFocused = Cancel
  If Not mFocused Then Refresh
End Sub
 
Private Sub UserControl_EnterFocus()
  If lbHwnd Then SetFocusAPI lbHwnd
  mFocused = True
End Sub
 
Private Sub picHeader_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  mLastHDX = x + mHScrollX
End Sub
Private Sub picHeader_Click()
Dim ColIndex As Long
  ListIndex = -1
  ColIndex = GetColumnIndex(mLastHDX)
  If lbHwnd Then UserControl_EnterFocus
  RaiseEvent HeaderClick(ListIndex, ColIndex, IIf(ColIndex = mSortColumn, mSortMode, CS_NONE))
End Sub

Private Function GetColumnIndex(ByVal LastMouseX As Long, Optional ColX As Long) As Long
Dim ColWidthTotal As Long, ColWidth
  For Each ColWidth In ColWidths
    ColWidthTotal = ColWidthTotal + ColWidth
    If ColWidthTotal > LastMouseX Or ColWidthTotal >= mColWidthTotal Then Exit For
    GetColumnIndex = GetColumnIndex + 1
  Next
  ColX = ColWidthTotal - ColWidth - mHScrollX
End Function

Private Sub ucSC_WindowProc(Result As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long)
Const WM_DRAWITEM& = &H2B, WM_COMMAND& = &H111&, WM_CTLCOLORLISTBOX& = &H134, WM_ERASEBKGND& = &H14
Const LBN_SELCHANGE& = 1, LBN_DBLCLICK& = 2
Static stLastListIndex As Long, stLastColIndex As Long, LastMsg As Long, LastTop As Long
Dim i&, x&, y&, dx&, dy&, HX&, Pt(1) As Long, Rct As RECT
  On Error Resume Next
  
  If Msg <> WM_DRAWITEM And Msg <> WM_ERASEBKGND And (LastMsg = WM_DRAWITEM Or ListCountChanged) Then
    ListCountChanged = False
 
    SendMessage lbHwnd, LB_GETITEMRECT, 0, Rct
    x = -mHScrollX
    dx = Rct.Right
    dy = RowHeight
    
    picDraw.Move 0, mHeaderHeight, dx + x, ScaleHeight - mHeaderHeight - IIf(mColWidthTotal > dx + x, ScaleWidth - (dx + x), 0)
    If picDraw.BackColor <> UserControl.BackColor Then picDraw.BackColor = UserControl.BackColor
    picDraw.Cls
    SetBkMode picDraw.hDC, 0
    For i = TopIndex To TopIndex + VisibleRows + 1
      FillRectangle picDraw.hDC, x, y, dx, dy, UserControl.BackColor
      RaiseEvent OwnerDrawItem(picDraw.hDC, x, y, dx, dy, i, i = ListIndex)
      y = y + dy
    Next
    picDraw.Refresh
  End If
 
  If Msg = WM_CTLCOLORLISTBOX Then
    Result = 0
  ElseIf Msg = WM_DRAWITEM Then
    HX = GetScrollPos(lbHwnd, 0)
    If mHScrollX <> HX Then mHScrollX = HX: RefreshHeader: EditMove
    If LastTop <> TopIndex Then LastTop = TopIndex: EditMove
    
  ElseIf Msg = WM_COMMAND And wParam \ 65536 = LBN_SELCHANGE Then
    If GetAsyncKeyState(1) Then
      picHeader.SetFocus
      UserControl_EnterFocus
    End If
    
    GetCursorPos Pt(0)
    ScreenToClient lbHwnd, Pt(0)
    mLastLBX = Pt(0) + mHScrollX
    stLastListIndex = ListIndex
    stLastColIndex = GetColumnIndex(mLastLBX)
    If Not mBlockClickEvents Then RaiseEvent Click(stLastListIndex, stLastColIndex)
    EditMove True
    
  ElseIf Msg = WM_COMMAND And wParam \ 65536 = LBN_DBLCLICK Then
    RaiseEvent DblClick(stLastListIndex, stLastColIndex)
  Else
    Result = ucSC.CallWindowProc(Msg, wParam, lParam)
  End If
  LastMsg = Msg
End Sub

'a Helper-Function with a lot of Params, but this way we don't need any GDI-API-Declares in the Control-Hosting Containers (usually the VB-Forms)
Public Sub DrawTextCell(ByVal hDC As Long, S As String, ByVal Align As DTAlignment, _
                        ByVal x As Long, ByVal y As Long, ByVal dx As Long, ByVal dy As Long, _
                        Optional ByVal TextColor As Long, Optional ByVal BackColor As Long = -1, _
                        Optional ByVal VCenter As Boolean = True, Optional InnerSpace As Long = 3, _
                        Optional ByVal MultiLine As Boolean, Optional ByVal Ellipsis As Boolean = True)
  
  If mColScan Then ColWidths.Add dx: mColWidthTotal = mColWidthTotal + dx
  If BackColor <> -1 Then FillRectangle hDC, x, y, dx, dy, BackColor
 
  Const DT_VCENTER& = 4, DT_SINGLELINE& = &H20, DT_END_ELLIPSIS& = &H8000&
  Dim Rct As RECT, DTP As DRAWTEXTPARAMS, OldFont&, F As IFont
      Rct.Left = x: Rct.Top = y: Rct.Right = x + dx: Rct.Bottom = y + dy
  Set F = Font
  OldFont = SelectObject(hDC, F.hFont)
    SetTextColor hDC, TextColor
    DTP.cbSize = Len(DTP)
    DTP.iLeftMargin = InnerSpace: DTP.iRightMargin = InnerSpace
    If VCenter Then Align = Align Or DT_VCENTER Else Align = Align And Not DT_VCENTER
    If MultiLine Then Align = Align And Not DT_SINGLELINE Else Align = Align Or DT_SINGLELINE
    If Ellipsis Then Align = Align Or DT_END_ELLIPSIS Else Align = Align And Not DT_END_ELLIPSIS
    If Len(S) Then DrawTextEx hDC, StrPtr(S), Len(S), Rct, Align, DTP
  SelectObject hDC, OldFont
End Sub

Public Sub DrawLineHorz(ByVal hDC As Long, ByVal x&, ByVal y&, ByVal dx&, Optional ByVal LineColor As Long = &HBBBBBB)
Dim hPenOld&
    hPenOld = SelectObject(hDC, CreatePen(0, 1, LineColor))
    MoveToEx hDC, x, y: LineTo hDC, x + dx, y
    DeleteObject SelectObject(hDC, hPenOld)
End Sub
Public Sub DrawLineVert(ByVal hDC As Long, ByVal x&, ByVal y&, ByVal dy&, Optional ByVal LineColor As Long = &HBBBBBB)
Dim hPenOld&
    hPenOld = SelectObject(hDC, CreatePen(0, 1, LineColor))
    MoveToEx hDC, x, y: LineTo hDC, x, y + dy
    DeleteObject SelectObject(hDC, hPenOld)
End Sub

Public Sub FillRectangle(ByVal hDC As Long, ByVal x&, ByVal y&, ByVal dx&, ByVal dy&, ByVal Color As Long)
Dim Rct As RECT, hBrush&
    Rct.Left = x: Rct.Top = y: Rct.Right = x + dx: Rct.Bottom = y + dy
    hBrush = CreateSolidBrush(Color)
    FillRect hDC, Rct, hBrush
    DeleteObject hBrush
End Sub

Public Sub SetSortIndicator(ByVal SortColumn As Long, Optional ByVal SortMode As ColSortMode, Optional ByVal SortColor As Long = &HFFE0D0)
  mSortMode = SortMode: mSortColumn = SortColumn: mSortColor = SortColor
  RefreshHeader
  Refresh
End Sub
Private Sub DrawSortIndicator()
  Dim i As Long, j As Long, x As Long
  For i = 0 To ColWidths.Count - 1
    If i = mSortColumn Then Exit For Else x = x + ColWidths(i + 1)
  Next
  If ColWidths.Count = 0 Then Exit Sub Else x = x + ColWidths(i + 1) / 2 - mHScrollX
 
  picHeader.ForeColor = mSortColor
  For i = 0 To 3
    If mSortMode = CS_ASCENDING Then j = 2 * i + 1 Else j = 7 - 2 * i
    MoveToEx picHeader.hDC, x - j \ 2, i, 0: LineTo picHeader.hDC, x + j \ 2 + 1, i
  Next i
End Sub

Private Sub UserControl_Terminate()
  If Not ucSC Is Nothing Then ucSC.UnHook
  If lbHwnd Then DestroyWindow lbHwnd
End Sub

